Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/HyperCard Related/XCMDs & XFCNs/DrawPictInRect/DrawPictInRect.p

Text File | 1991-03-29 | 6.1 KB | 282 lines | [TEXT/MPS ]

{$R-}
{$S DrawPictInRect }

{

    DrawPictInRect (TargetRect, TextLabel)

     This HyperCard XFCN creates a drawing with the bounds that are passed in
    TargetRect and leaves it on the clipboard to be pasted by HyperCard.

    The drawing that results is a true PICT; that is, it is object-oriented
    and if it were saved in a file or pasted into another application, the
    objects would become editable.  Of course, once HyperCard pastes the
    PICT, it will no longer be editable; HyperCard converts everything to
    bitmaps when they are pasted.

    TargetRect will be the picture frame of the PICT.  Its size is limited
    to 0 (top and left) and 16000 (bottom and right).

    If the XFCN is successful, then empty is returned, otherwise the return value
    is an error message.

    The drawing that is created is very boring: just a rectangle with an
    X drawn through it, and a string drawn somewhere within it.

    Use this XFCN as a template for others that make more useful drawings.

}

UNIT DummyUnit;

INTERFACE

    USES {* ToolIntf, PackIntf, *}
            Menus, Events, TextEdit, HyperXCmd,
            MemTypes, OSIntf, Scrap, QuickDraw, SANE;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

    PROCEDURE DrawPictInRect(paramPtr: XCmdPtr);
    FORWARD;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
    BEGIN
        DrawPictInRect(paramPtr)
    END { entrypoint } ;


    PROCEDURE DrawPictInRect(paramPtr: XCmdPtr);
    CONST

    MinParams =        2;
    MaxParams =        2;

    TYPE

    ParamArray =        PACKED ARRAY [1..MaxParams] OF Str255;

    VAR

    ParamStrings:        ParamArray;

    TargetRectParam:    Rect;
    TextLabelParam:        Str255;

    ThePict:            PicHandle;

        PROCEDURE ExitWithString(aString: Str255);
        BEGIN
            WITH paramPtr^ DO BEGIN
                returnValue := PasToZero(paramPtr, aString);
                EXIT(DrawPictInRect);
            END;
        END;

        PROCEDURE ExitWithError(aString: Str255);
        BEGIN
            ExitWithString(concat('•••••••• Error: ', aString, '.'));
        END;

        PROCEDURE LimitRectValue(VAR ARect: Rect);
        BEGIN
            IF (ARect.Left < 0) THEN ARect.Left := 0;
            IF (ARect.Top < 0) THEN ARect.Top := 0;
            IF (ARect.Right > 16000) THEN ARect.Right := 16000;
            IF (ARect.Bottom > 16000) THEN ARect.Bottom := 16000;
        END;

        {
            This is where the drawing is done.
            DrawRect is the boundary of the drawing.

            Drawing is done in whatever Quickdraw context is current -- that is,
            the code in this routine should be insensitive to whether drawing
            is happening inside a bitmap or inside a PICT.

            For this sample XFCN, a border is drawn around/within the given rect,
            an X is drawn across the rect, and the string specified by
            TextLabelParam is drawn somewhere in the middle.

         }
        FUNCTION DoTheDrawing(DrawRect: Rect): BOOLEAN;
        VAR

            PenWidth:            Integer;
            PenHeight:            Integer;

            Top:                LONGINT;
            Left:                LONGINT;
            Bottom:                LONGINT;
            Right:                LONGINT;

        BEGIN

            PenWidth := 2;
            PenHeight := 2;

            Left := DrawRect.Left;
            Top := DrawRect.Top;
            Right := DrawRect.Right;
            Bottom := DrawRect.Bottom;

            { Make some calculations -- adjusting these for the pen size}
            Right := Right - PenWidth;
            Bottom := Bottom - PenWidth;

            { Start drawing }
            PenSize(PenWidth,PenHeight);
            MoveTo(Left,Top);
            LineTo(Left,Bottom);
            LineTo(Right,Bottom);
            LineTo(Right,Top);
            LineTo(Left,Top);

            MoveTo(Left,Top);
            LineTo(Right,Bottom);

            MoveTo(Right,Top);
            LineTo(Left,Bottom);

            MoveTo(Left + 30, Top + 20);
            DrawString(TextLabelParam);

            DoTheDrawing := TRUE;

        END;

        FUNCTION GeneratePict: PicHandle;
        VAR
            OldGrafPtr:        GrafPtr;

            aGrafPort:        GrafPort;
            aGrafPtr:        GrafPtr;

            ThePict:        PicHandle;
            Success:        Boolean;
        BEGIN

            { Remember the old GrafPort }
            GetPort(OldGrafPtr);

            { Set up a new GrafPort }
            aGrafPtr := @aGrafPort;

            OpenPort(aGrafPtr);

            aGrafPort.portRect := TargetRectParam;
            RectRgn(aGrafPort.visRgn, TargetRectParam);
            RectRgn(aGrafPort.clipRgn, TargetRectParam);

            { Open the Pict }
            ThePict := OpenPicture(TargetRectParam);

            { Do the drawing }
            Success := DoTheDrawing(TargetRectParam);

            { Close and return }
            ClosePicture;

            { Restore the original GrafPort }
            SetPort(OldGrafPtr);

            { Free the GrafPort we’ve been using}
            ClosePort(aGrafPtr);

            IF (NOT Success)
            THEN
                BEGIN
                    KillPicture(ThePict);
                    GeneratePict := NIL;
                END
            ELSE GeneratePict := ThePict;
        END;

        PROCEDURE DisposePict(ThePict: PicHandle);
        BEGIN
            KillPicture(ThePict);
        END;

        FUNCTION PutPictOntoClipboard(ThePict: PicHandle): OsErr;
        VAR
            ErrValue:        LONGINT;
        BEGIN

            ErrValue := ZeroScrap;
            PutPictOntoClipboard := ErrValue;
            IF (ErrValue <> NoErr)
            THEN Exit(PutPictOntoClipboard);

            HLock(Handle(ThePict));
            ErrValue := PutScrap(GetHandleSize(Handle(ThePict)),'PICT', Ptr(ThePict^));
            HUnlock(Handle(ThePict));

            PutPictOntoClipboard := ErrValue;
            IF (ErrValue <> NoErr)
            THEN Exit(PutPictOntoClipboard);

        END;

        PROCEDURE CleanUpBeforeEnding;
        BEGIN
            DisposePict(ThePict);
        END;

        PROCEDURE FailWithError(aString: Str255);
        BEGIN

            CleanUpBeforeEnding;
            ExitWithError(aString);
        END;

        PROCEDURE ParseParams;
        VAR
            ParamNum:            integer;
        BEGIN
            WITH paramPtr^ DO
            BEGIN
                IF (paramCount < MinParams) THEN ExitWithError('Too few parameters');
                IF (paramCount > MaxParams) THEN ExitWithError('Too many parameters');

                ParamNum := 1; {* Required *}

                ZeroToPas(ParamPtr, Params[ParamNum]^, ParamStrings[ParamNum]);
                StrToRect(paramPtr, ParamStrings[ParamNum], TargetRectParam);
                LimitRectValue(TargetRectParam);

                ParamNum := 2; {* Required *}

                ZeroToPas(paramPtr, Params[ParamNum]^, ParamStrings[ParamNum]);
                TextLabelParam := ParamStrings[ParamNum];

            END;
        END;

    BEGIN {DrawPictInRect}

        WITH paramPtr^ DO
        BEGIN

            ParseParams;

            ThePict := GeneratePict;
            IF (ThePict = NIL) THEN
            ExitWithError('Failed while generating picture');

            IF (PutPictOntoClipboard(ThePict) <> NoErr)
            THEN FailWithError('Couldn’t place PICT on clipboard');

            CleanUpBeforeEnding; { i.e. dispose of the PICT before quitting }

            ExitWithString('');

        END

    END { DrawPictInRect } ;

END. { DummyUnit }